home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / prtgrid2 / prtgrid.pas < prev    next >
Pascal/Delphi Source File  |  1995-12-22  |  20KB  |  860 lines

  1. unit Prtgrid;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils,  WinTypes,  WinProcs,  Messages,  Classes,  Graphics,  Controls, 
  7.     Forms,  Dialogs, DBGrids, DB
  8.     ;
  9.  
  10. const
  11.     MaxPages = 1000;
  12.     MaxCols = 100;
  13.  
  14.  
  15. type
  16.     TPageNumberPos = (pnNone,  pnTopLeft, pnTopCenter, pnTopRight, pnBotLeft, pnBotCenter, pnBotRight);
  17.  
  18.  
  19.   TPrintGrid = class(TComponent)
  20.   private
  21.     { Private declarations }
  22.         tmpFile: Text;
  23.         tmpFileName : TFileName;
  24.         FDBGrid: TDBGrid;
  25.         FHeaderInTitle: boolean;
  26.         FHeaderAlign: TAlignment;
  27.         FLinesFont: TFont;
  28.         FHeaderFont: TFont;
  29.         FTitleFont: TFont;
  30.         FPageNLabel: string;
  31.         FDateLabel: string;
  32.         FPageNPos: TPageNumberPos;
  33.         FDatePos: TPageNumberPos;
  34.         FPrintFileName: string;
  35.         FHeader: string;
  36.         FPrintMgrTitle: string;
  37.         FirstRecordY: longint;
  38.         LinesWidth: longint;
  39.         LinesHeight: longint;
  40.         RecCounter: longint;
  41.         FToPrint: boolean;
  42.         tmpPageNo: longint;
  43.         FFromPage: longint;
  44.         FToPage: longint;
  45.         NPositions: integer;
  46.         FTopMargin: integer;
  47.         FBottomMargin: integer;
  48.         FLeftMargin: integer;
  49.         FRightMargin: integer;
  50.         Positions: array[1..MaxCols] of longint;
  51.         FColLines: boolean;
  52.         FRowLines: boolean;
  53.         FBorder: boolean;
  54.         FHorizGap: integer;
  55.         FVertGap: integer;
  56.  
  57.         procedure WriteLineScreen(const S: string);
  58.         procedure SetTitleFont(Value: TFont);
  59.         procedure SetHeaderFont(Value: TFont);
  60.         procedure SetLinesFont(Value: TFont);
  61.         procedure SetDBGrid(Value: TDBGrid);
  62.         function GetDBGrid: TDBGrid;
  63.         procedure SetPrintMgrTitle(const S: string);
  64.         function GetPrintMgrTitle: string;
  65.         function OpenTextForWrite: boolean;
  66.         function ScreenWidth(tmp: TField): longint;
  67.         function TitleWidth(const S: string): longint;
  68.         function TitleHeight: longint;
  69.         procedure CalculatePositions;
  70.         function SetAlign(align:TAlignment; Left, Right: longint): longint;
  71.         function SetPagePosX(PagePos: TPageNumberPos; Left, Right: longint): longint;
  72.         function SetPagePosY(PagePos: TPageNumberPos; Top, Bottom: longint): longint;
  73.         function PrepareAlign(Field: TField; Col: integer): longint;
  74.         procedure WriteHeaderToPrinter;
  75.         procedure WriteLabelToPrinter(PosY: longint);
  76.         procedure WriteRecordToPrinter;
  77.         procedure WriteHeader;
  78.         procedure WriteRecord;
  79.         procedure PageJump;
  80.         function RealWidth: longint;
  81.         function AllPageFilled: boolean;
  82.  
  83.   protected
  84.         { Protected declarations }
  85.     procedure SetName(const Value: TComponentName); override;
  86.  
  87.   public
  88.     { Public declarations }
  89.         constructor Create(AOwner:TComponent); override;
  90.         destructor Destroy; override;
  91.     procedure Print;
  92.     procedure PrintDialog;
  93.  
  94.     published
  95.         { Published declarations }
  96.         property LeftMargin: integer read FLeftMargin write FLeftMargin;
  97.         property TopMargin: integer read FTopMargin write FTopMargin;
  98.         property RightMargin: integer read FRightMargin write FRightMargin;
  99.         property BottomMargin: integer read FBottomMargin write FBottomMargin;
  100.         property TitleFont: TFont read FTitleFont write SetTitleFont;
  101.         property HeaderFont: TFont read FHeaderFont write SetHeaderFont;
  102.         property LinesFont: TFont read FLinesFont write SetLinesFont;
  103.         property DBGrid: TDBGrid read GetDBGrid write SetDBGrid;
  104.         property PrintMgrTitle: string read GetPrintMgrTitle write SetPrintMgrTitle;
  105. {        property HeaderInTitle: boolean read FHeaderInTitle write FHeaderinTitle;}{cannot get this to work properly}
  106.         property Header: string read FHeader write FHeader;
  107.         property HeaderAlignment: TAlignment read FHeaderAlign write FHeaderAlign;
  108.         property PrintToFile: boolean read FToPrint write FToPrint;
  109.         property PrintFileName: string read FPrintFileName write FPrintFileName;
  110.         property FromPage: longint read FFromPage write FFromPage;
  111.     property ToPage: longint read FToPage write FToPage;
  112.         property Border: boolean read FBorder write FBorder;
  113.         property ColLines: boolean read FColLines write FColLines;
  114.         property RowLines: boolean read FRowLines write FRowLines;
  115.         property HorizontalGap: integer read FHorizGap write FHorizGap;
  116.         property VerticalGapPct: integer read FVertGap write FVertGap;
  117.         property PageNumberPos: TPageNumberPos read FPageNPos write FPageNPos;
  118.         property PageNumberLabel: string read FPageNLabel write FPageNLabel;
  119.         property DatePos: TPageNumberPos read FDatePos write FDatePos;
  120.         property DateLabel: string read FDateLabel write FDateLabel;
  121.     end;
  122.  
  123. procedure Register;
  124.  
  125.  
  126. implementation
  127.  
  128. uses
  129.     Printers;
  130.  
  131.  
  132. function Max(a, b: longint): longint;
  133. begin
  134.     if a > b then
  135.         Result := a
  136.     else
  137.         Result := b;
  138. end;
  139.  
  140.  
  141. function FileNameExists(FileName: string): boolean;    { Check whether file exists and return true if it does }
  142. var
  143.     F: File;
  144. begin
  145.   Assign(F, FileName);
  146.     {$I-} Reset(F); {$I+}
  147.  
  148.     if IoResult <> 0 then
  149.         begin
  150.             FileNameExists := false;                                      { i.e. file information is in memory }
  151.         end
  152.     else
  153.         begin
  154.             Close(F);                                                            { Note: File does NOT remain open }
  155.             FileNameExists := true;                                          { i.e. file information is in memory }
  156.         end;
  157.  
  158. end;
  159.  
  160.  
  161. function Scale(Value: longint; Pct: integer): longint;
  162. begin
  163.     if Pct > 100 then
  164.         Pct := 100
  165.     else if Pct < 0 then
  166.         Pct := 0;
  167.  
  168.     if Pct = 0 then
  169.         Result := Value
  170.     else
  171.         Result := Value + MulDiv(Value, Pct, 100);
  172. end;
  173.  
  174.  
  175. function CenterY(PosY, TextHt, Pct: longint): longint;
  176. begin
  177.     Result := PosY + (Scale(TextHt, Pct) - TextHt) div 2;
  178. end;
  179.  
  180.  
  181.  
  182. constructor TPrintGrid.Create(AOwner:TComponent);
  183. begin
  184.     inherited Create(AOwner);
  185.     FTitleFont := TFont.Create;
  186.     FHeaderFont := TFont.Create;
  187.     FLinesFont := TFont.Create;
  188.  
  189.     { DEFAULT VALUES FOR ALL PROPERTIES }
  190.     FDBGrid := nil;
  191.   FHeader := '';
  192.   FPrintMgrTitle := '';
  193.   RecCounter := 0;
  194.   FHorizGap := 2;
  195.     FVertGap := 20;
  196.     FTopMargin := 40;
  197.     FBottomMargin := 40;
  198.     FLeftMargin := 30;
  199.     FRightMargin := 30;
  200.     FToPrint := False;
  201.     FPrintFileName := '';
  202.   FFromPage := 1;
  203.   FToPage := MaxPages;
  204.     FBorder := True;
  205.     FColLines := True;
  206.     FRowLines := False;
  207.   FHeaderAlign := taCenter;
  208.   FHeaderIntitle := False;
  209.     FPageNPos := pnTopRight;
  210.     FPageNLabel := 'Page: ';
  211.     FDatePos := pnTopLeft;
  212.     FDateLabel := '';
  213. end;
  214.  
  215.  
  216. destructor TPrintGrid.Destroy;
  217. begin
  218.     FTitleFont.Free;
  219.     FHeaderFont.Free;
  220.   FLinesFont.Free;
  221.     inherited Destroy;
  222. end;
  223.  
  224.  
  225. procedure TPrintGrid.SetTitleFont(Value: TFont);
  226. begin
  227.     FTitleFont.Assign(Value);
  228. end;
  229.  
  230.  
  231. procedure TPrintGrid.SetHeaderFont(Value: TFont);
  232. begin
  233.     FHeaderFont.Assign(Value);
  234. end;
  235.  
  236.  
  237. procedure TPrintGrid.SetLinesFont(Value: TFont);
  238. begin
  239.     FLinesFont.Assign(Value);
  240. end;
  241.  
  242.  
  243. procedure TPrintGrid.SetDBGrid(Value: TDBGrid);
  244. begin
  245.     FDBGrid := Value;
  246. end;
  247.  
  248.  
  249. function TPrintGrid.GetDBGrid: TDBGrid;
  250. begin
  251.     Result := FDBGrid;
  252. end;
  253.  
  254.  
  255. procedure TPrintGrid.SetPrintMgrTitle(const S: string);
  256. begin
  257.     FPrintMgrTitle := S;
  258. end;
  259.  
  260.  
  261. function TPrintGrid.GetPrintMgrTitle: string;
  262. begin
  263.     Result := FPrintMgrTitle;
  264. end;
  265.  
  266.  
  267. procedure TPrintGrid.SetName(const Value: TComponentName);
  268. var
  269.   ChangeText: Boolean;
  270. begin
  271.     ChangeText := (Name = FPrintMgrTitle) and ((Owner = nil) or not (Owner is TPrintGrid) or
  272.                                     not (csLoading in TPrintGrid(Owner).ComponentState));
  273.  
  274.     inherited SetName(Value);
  275.  
  276.     if ChangeText then
  277.         FPrintMgrTitle := Value;
  278. end;
  279.  
  280.  
  281. procedure TPrintGrid.WriteLineScreen(const S: string);
  282. begin
  283.     if (tmpPageNo >= FFromPage) and (tmpPageNo <= FToPage) then
  284.         Writeln(tmpFile, S);
  285. end;
  286.  
  287.  
  288. function TPrintGrid.OpenTextForWrite: boolean;
  289. begin
  290.     if tmpFileName <> '' then
  291.         begin
  292.             {$I-}
  293.             AssignFile(tmpFile, tmpFileName);
  294.             rewrite(tmpFile);
  295.             {$I+}
  296.             Result := (ioresult = 0);
  297.         end
  298.  
  299.     else
  300.         Result := false;
  301. end;
  302.  
  303.  
  304. function TPrintGrid.ScreenWidth(tmp:TField): longint;
  305. begin
  306.     Result := Max(tmp.DisplayWidth, Length(tmp.DisplayLabel));
  307. end;
  308.  
  309.  
  310. function TPrintGrid.TitleWidth(const S: string): longint;
  311. var
  312.     tmpFont: TFont;
  313. begin
  314.     with Printer.Canvas do
  315.     begin
  316.         tmpFont := TFont.Create;
  317.         tmpFont.Assign(Font);
  318.         Font.Assign(FTitleFont);
  319.         Result := TextWidth(s);
  320.         Font.Assign(tmpFont);
  321.         tmpFont.Free;
  322.     end;
  323. end;
  324.  
  325.  
  326. function TPrintGrid.TitleHeight: longint;
  327. var
  328.     tmpFont: TFont;
  329. begin
  330.     with Printer.Canvas do
  331.     begin
  332.         tmpFont := TFont.Create;
  333.         tmpFont.Assign(Font);
  334.         Font.Assign(FTitleFont);
  335.         Result := Scale(TextHeight('M'), FVertGap);
  336.         Font.Assign(tmpFont);
  337.         tmpFont.Free;
  338.     end;
  339. end;
  340.  
  341.  
  342. procedure TPrintGrid.CalculatePositions;
  343. var
  344.     ColWidth, t: longint;
  345. begin
  346.     NPositions := 0;
  347.  
  348.     if FBorder then
  349.         Positions[1] := 1
  350.     else
  351.         Positions[1] := 0;
  352.  
  353.     with FDBGrid.DataSource.DataSet do
  354.  
  355.         for t := 0 to FieldCount - 1 do
  356.         with Fields[t] do
  357.  
  358.         if Visible then
  359.         begin
  360.             inc(NPositions);
  361.             ColWidth := Max(TitleWidth(Fields[t].DisplayLabel), (LinesWidth * Fields[t].DisplayWidth));
  362.             Positions[NPositions + 1] := Positions[NPositions] + ColWidth + FHorizGap;
  363.         end;
  364. end;
  365.  
  366.  
  367. function TPrintGrid.SetAlign(align: TAlignment; Left, Right: longint): longint;
  368. var
  369.     PosX: longint;
  370. begin
  371.     with Printer.Canvas do
  372.     begin
  373.         case Align of
  374.             taLeftJustify:
  375.                 begin
  376.                     SetTextAlign(Handle, TA_LEFT);
  377.                     PosX := Left + FHorizGap;
  378.                 end;
  379.  
  380.             taRightJustify:
  381.                 begin
  382.                     SetTextAlign(Handle, TA_RIGHT);
  383.                     PosX := Right - FHorizGap;
  384.                 end;
  385.  
  386.             taCenter:
  387.                 begin
  388.                     SetTextAlign(Handle, TA_CENTER);
  389.                     PosX := Left + Round((Right - Left) / 2);
  390.                 end;
  391.         end;
  392.     end;
  393.  
  394.     Result := PosX;
  395. end;
  396.  
  397.  
  398. function TPrintGrid.SetPagePosX(PagePos: TPageNumberPos; Left, Right: longint): longint;
  399. var
  400.     PosX: longint;
  401. begin
  402.     with Printer.Canvas do
  403.     begin
  404.         case PagePos of
  405.             pnTopLeft, pnBotLeft:
  406.                 begin
  407.                     SetTextAlign(Handle, TA_LEFT);
  408.                     PosX := Left + FHorizGap;
  409.                 end;
  410.  
  411.             pnTopRight, pnBotRight:
  412.                 begin
  413.                     SetTextAlign(Handle, TA_RIGHT);
  414.                     PosX := Right - FHorizGap;
  415.                 end;
  416.  
  417.             pnTopCenter, pnBotCenter:
  418.                 begin
  419.                     SetTextAlign(Handle, TA_CENTER);
  420.                     PosX := Left + Round((Right - Left)/2);
  421.                 end;
  422.         end;
  423.     end;
  424.  
  425.     Result := PosX;
  426. end;
  427.  
  428.  
  429. function TPrintGrid.SetPagePosY(PagePos: TPageNumberPos; Top, Bottom: longint): longint;
  430. var
  431.     PosY: longint;
  432. begin
  433.         case PagePos of
  434.             pnBotLeft, pnBotCenter, pnBotRight:
  435.                 begin
  436.                     PosY := Bottom;
  437.                 end;
  438.  
  439.         else
  440.             PosY := Top;
  441.         end;
  442.  
  443.     Result := PosY;
  444. end;
  445.  
  446.  
  447. function TPrintGrid.PrepareAlign(Field:TField; Col:integer): longint;
  448. begin
  449.     Result := SetAlign(Field.Alignment, Positions[col], Positions[col + 1]);
  450. end;
  451.  
  452.  
  453. procedure TPrintGrid.WriteHeaderToPrinter;
  454. var
  455.     PosX, PosY, t, tmpTitleHeight: longint;
  456.     TmpFont: TFont;
  457.     FontCreated: boolean;
  458. begin
  459.     if (tmpPageNo >= FFromPage) and (tmpPageNo <= FToPage) then
  460.     begin
  461.         tmpTitleHeight := TitleHeight;
  462.  
  463.         with Printer.Canvas do
  464.         begin
  465.             if (FHeader <> '') or (FDatePos <> pnNone) or (FPageNPos <> pnNone) then
  466.                 begin
  467.                     tmpFont := TFont.Create;
  468.                     tmpFont.Assign(Font);
  469.                     Font.Assign(FHeaderFont);
  470.                     FontCreated := true;
  471.                 end
  472.             else
  473.                 FontCreated := false;
  474.  
  475.             if FDatePos <> pnNone then
  476.             begin
  477.                 PosX := SetPagePosX(FDatePos, FLeftMargin, FLeftMargin + Positions[NPositions + 1]);
  478.                 PosY := SetPagePosY(FDatePos, FTopMargin, Printer.PageHeight - FBottomMargin);
  479.                 TextOut(PosX, PosY, FDateLabel);
  480.             end;
  481.  
  482.             if FHeader <> '' then
  483.             begin
  484.                 PosX := SetAlign(FHeaderAlign, FLeftMargin, FLeftMargin + Positions[NPositions + 1]);
  485.                 TextOut(PosX, FTopMargin, FHeader);
  486.             end;
  487.  
  488.             if FPageNPos <> pnNone then
  489.             begin
  490.                 PosX := SetPagePosX(FPageNPos, FLeftMargin, FLeftMargin + Positions[NPositions + 1]);
  491.                 PosY := SetPagePosY(FPageNPos, FTopMargin, Printer.PageHeight - FBottomMargin);
  492.                 TextOut(PosX, PosY, FPageNLabel + IntToStr(tmpPageNo));
  493.             end;
  494.  
  495.             if (FHeader <> '') or (FDatePos in [pnTopLeft, pnTopCenter, pnTopRight])
  496.                                                  or (FPageNPos in [pnTopLeft, pnTopCenter, pnTopRight]) then
  497.                 FirstRecordY := FTopMargin + Scale(TextHeight('M'), FVertGap) + tmpTitleHeight
  498.             else
  499.                 FirstRecordY := FTopMargin + tmpTitleHeight;
  500.  
  501.             if FontCreated then
  502.             begin
  503.                 Font.Assign(tmpFont);
  504.                 tmpFont.Free;
  505.             end;
  506.         end;
  507.  
  508.         if FBorder then
  509.         begin
  510.             if FHeaderinTitle then
  511.                 Printer.Canvas.Rectangle(FLeftMargin, FTopMargin, FLeftMargin + Positions[NPositions + 1],
  512.                                                                  Printer.PageHeight - FBottomMargin)
  513.             else
  514.                 Printer.Canvas.Rectangle(FLeftMargin, FirstRecordY - tmpTitleHeight, FLeftMargin + Positions[NPositions + 1],
  515.                                                                  Printer.PageHeight - FBottomMargin)
  516.         end;
  517.  
  518.         if FColLines then
  519.             with Printer.Canvas do
  520.             for t := 2 to NPositions do
  521.             begin
  522.                 MoveTo(FLeftMargin + Positions[t], FirstRecordY);
  523.                 LineTo(FLeftMargin + Positions[t], Printer.PageHeight - FBottomMargin);
  524.             end;
  525.  
  526.         WriteLabelToPrinter(FirstRecordY - tmpTitleHeight);
  527.     end;
  528. end;
  529.  
  530.  
  531. procedure TPrintGrid.WriteLabelToPrinter(PosY: longint);
  532. var
  533.     Col, PosX, t: longint;
  534.     TmpFont: TFont;
  535.     R: TRect;
  536. begin
  537.     with FDBGrid.DataSource.DataSet do
  538.         with Printer.Canvas do
  539.         begin
  540.             tmpFont := TFont.Create;
  541.             tmpFont.Assign(Font);
  542.             Font.Assign(FTitleFont);
  543.             Col := 0;
  544.             R.top := CenterY(PosY, TextHeight('M'), FVertGap);;
  545.             R.bottom := FirstRecordY + ((RecCounter + 1) * LinesHeight);
  546.  
  547.             for t := 0 to FieldCount - 1 do
  548.             begin
  549.                 if Fields[t].Visible then
  550.                 begin
  551.                     inc(Col);
  552.                     PosX := FLeftMargin + PrepareAlign(Fields[t], Col);
  553.                     R.left := FLeftMargin + Positions[Col] + FHorizGap;
  554.                     R.right := FLeftMargin + Positions[Col+1] - FHorizGap;
  555.                     TextRect(R, PosX, R.top, Fields[t].DisplayLabel);
  556.                 end;
  557.             end;
  558.  
  559.             Moveto(FLeftMargin, FirstRecordY);
  560.             Lineto(FLeftMargin + Positions[NPositions + 1], FirstRecordY);
  561.             Font.Assign(tmpFont);
  562.             tmpFont.Free;
  563.         end;
  564. end;
  565.  
  566.  
  567. procedure TPrintGrid.WriteRecordToPrinter;
  568. var
  569.     Col, t, PosX, PosY: longint;
  570.     tmpFont: TFont;
  571.     R: TRect;
  572. begin
  573.     if (tmpPageNo >= FFromPage) and (tmpPageNo <= FToPage) then
  574.     begin
  575.         with FDBGrid.DataSource.DataSet do
  576.         begin
  577.             with Printer.Canvas do
  578.             begin
  579.                 tmpFont := TFont.Create;
  580.                 tmpFont.Assign(Font);
  581.                 Font.Assign(FLinesFont);
  582.                 Col := 0;
  583.                 PosY := FirstRecordY + RecCounter * LinesHeight;
  584.                 R.top := CenterY(PosY, TextHeight('M'), FVertGap);
  585.                 R.bottom := FirstRecordY + ((RecCounter + 1) * LinesHeight);
  586.  
  587.                 for t := 0 to FieldCount - 1 do
  588.                 begin
  589.                     if Fields[t].Visible then
  590.                     begin
  591.                         inc(Col);
  592.                         PosX := FLeftMargin + PrepareAlign(Fields[t], Col);
  593.                         R.left := FLeftMargin + Positions[Col] + FHorizGap;
  594.                         R.right := FLeftMargin + Positions[Col+1] - FHorizGap;
  595.                         TextRect(R, PosX, R.top, Fields[t].DisplayText);
  596.                     end;
  597.                 end;
  598.  
  599.                 if FRowLines then
  600.                 with Printer.Canvas do
  601.                 begin
  602.                     MoveTo(FLeftMargin, PosY);
  603.                     LineTo(FLeftMargin + Positions[NPositions + 1], PosY);
  604.                 end;
  605.  
  606.                 Font.Assign(tmpFont);
  607.                 tmpFont.Free;
  608.             end;
  609.         end;
  610.     end;
  611. end;
  612.  
  613.  
  614. procedure TPrintGrid.WriteHeader;
  615. var
  616.     t: longint;
  617.     S: string;
  618. begin
  619.     if not FToPrint then
  620.         WriteHeaderToPrinter
  621.  
  622.     else
  623.         with FDBGrid.DataSource.DataSet do
  624.         begin
  625.             WriteLineScreen(FHeader);
  626.             S := '';
  627.  
  628.       for t := 0 to FieldCount - 1 do
  629.             begin
  630.                 if Fields[t].Visible then
  631.                     S := S + Fields[t].DisplayLabel + #9;
  632.             end;
  633.  
  634.             WriteLineScreen(S);
  635.         end;
  636. end;
  637.  
  638.  
  639. procedure TPrintGrid.WriteRecord;
  640. var
  641.     t: word;
  642.     S: string;
  643. begin
  644.     if not FToPrint then
  645.         WriteRecordToPrinter
  646.  
  647.     else
  648.         begin
  649.             with FDBGrid.DataSource.DataSet do
  650.             begin
  651.                 S := '';
  652.  
  653.                 for t := 0 to FieldCount - 1 do
  654.                 begin
  655.                     if Fields[t].Visible then
  656.                         S := S + Fields[t].DisplayText + #9;
  657.                 end;
  658.             end;
  659.  
  660.             WriteLineScreen(S);
  661.         end;
  662. end;
  663.  
  664.  
  665. procedure TPrintGrid.PageJump;
  666. begin
  667.     RecCounter := 0;
  668.  
  669.     if not FToPrint then
  670.         if (tmpPageNo >= FFromPage) and (tmpPageNo < FToPage) then
  671.             Printer.NewPage;
  672.  
  673.     inc(tmpPageNo);
  674. end;
  675.  
  676.  
  677. function TPrintGrid.RealWidth: longint;
  678. begin
  679.     Result := Printer.PageWidth - FLeftMargin - FRightMargin;
  680. end;
  681.  
  682.  
  683. function TPrintGrid.AllPageFilled: boolean;
  684. begin
  685.     Result := (FToPrint and (RecCounter = 66)) or
  686.                         (not FToPrint and
  687.                         ((FirstRecordY + (RecCounter + 1) * LinesHeight) >= (Printer.PageHeight - FBottomMargin)));
  688. end;
  689.  
  690.  
  691. procedure TPrintGrid.Print;
  692. var
  693.     res: boolean;
  694.     St: array[0..255] of Char;
  695.     BookMark: TBookMark;
  696.     t: integer;
  697.     tmpFont: TFont;
  698. begin
  699.     if not Assigned(FDBGrid) then
  700.         raise Exception.Create('PrintGrid. DBGrid Property Was Not Specified.');
  701.  
  702.     if FToPrint then
  703.         res := OpenTextForWrite
  704.  
  705.   else
  706.         begin
  707.             res := true;
  708.  
  709.             with Printer do
  710.             begin
  711.                 Title := FPrintMgrTitle;
  712.                 BeginDoc;
  713.  
  714.                 with Canvas do
  715.                 begin
  716.                     tmpFont := TFont.Create;
  717.                     tmpFont.Assign(Font);
  718.                     Font.Assign(FLinesFont);
  719.                     LinesHeight := Scale(TextHeight('M'), FVertGap);
  720.                     LinesWidth := TextWidth('0');
  721.                     Font.Assign(tmpFont);
  722.                     tmpFont.Free;
  723.                 end;
  724.             end;
  725.     end;
  726.  
  727.     if res then
  728.   begin
  729.     with FDBGrid.DataSource.DataSet do
  730.         try
  731.             Screen.Cursor := crHourGlass;
  732.             Bookmark := GetBookMark;
  733.       DisableControls;
  734.       First;
  735.       RecCounter := 0;
  736.       tmpPageNo := 1;
  737.             CalculatePositions; { where to place each field in horizontal plane? }
  738.  
  739.             if not FToPrint and (Positions[NPositions + 1] > RealWidth) then
  740.             begin
  741.                 Screen.Cursor := crDefault;
  742.                 ShowMessage('Report Width Is Greater Than Paper Width.'); { useful in design }
  743.                 Screen.Cursor := crHourGlass;
  744.             end;
  745.  
  746.             while not EOF do
  747.       begin
  748.                 if RecCounter = 0 then
  749.                     WriteHeader;
  750.  
  751.                 WriteRecord;
  752.                 Inc(RecCounter);
  753.                 next;
  754.  
  755.                 if AllPageFilled then
  756.         begin
  757.           PageJump;
  758.  
  759.                     if tmpPageNo > FToPage then
  760.                         break;
  761.         end;
  762.             end;
  763.  
  764.     finally
  765.             Screen.Cursor := crDefault;
  766.             GotoBookMark(BookMark);
  767.       EnableControls;
  768.             FreeBookMark(BookMark);
  769.  
  770.             if FToPrint then
  771.                 System.closefile(tmpFile)
  772.             else
  773.                 Printer.EndDoc;
  774.     end;
  775.     end
  776.  
  777.     else
  778.         raise Exception.Create('Error Creating Report.');
  779. end;
  780.  
  781.  
  782. procedure TPrintGrid.PrintDialog;
  783. var
  784.     M: integer;
  785. begin
  786.     with TPrintDialog.Create(Self) do
  787.     begin
  788.         try
  789.             Options := [poPageNums, poPrintToFile, poWarning];    {poHelp}
  790.             MinPage := 1;
  791.             MaxPage := MaxPages;
  792.             FFromPage := 1;
  793.             FToPage := MaxPages;
  794.  
  795.             if Execute then
  796.             begin
  797.                 if PrintRange = prPageNums then
  798.                 begin
  799.                     FFromPage := FromPage;
  800.                     FToPage := ToPage;
  801.                 end;
  802.  
  803.                 if not PrintToFile then
  804.                     begin
  805.                         FToPrint := false;
  806.                         Print;
  807.                     end
  808.                 else
  809.                     begin
  810.                         FToPrint := true;
  811.  
  812.                         with TSaveDialog.Create(Self) do
  813.                         begin
  814.                             try
  815.                                 Filter := 'Text files (*.TXT)|*.TXT|Any file (*.*)|*.*';
  816.  
  817.                                 if FPrintFileName <> '' then
  818.                                 begin
  819.                                     FileName := FPrintFileName;
  820.                                     Filter := Filter + '|This file (*' + ExtractFileExt(FileName) + ')|*' + ExtractFileExt(FileName);
  821.                                     FilterIndex := 3;
  822.                                 end;
  823.  
  824.                                 if Execute then
  825.                                 begin
  826.                                     M := mrYes;
  827.  
  828.                                     if FileNameExists(FileName) then
  829.                                         M := MessageDlg(FileName + ' Already Exists. Do You Want To Overwrite This File?',
  830.                                                                         mtConfirmation, [mbYes, mbNo], 0);
  831.  
  832.                                     if M = mrYes then
  833.                                     begin
  834.                                         tmpFileName := FileName;
  835.                                         Print;
  836.                                     end;
  837.                                 end;
  838.  
  839.                             finally
  840.                                 Free;
  841.                             end;
  842.                         end;
  843.                     end;
  844.             end;
  845.  
  846.         finally
  847.             Free;
  848.         end;
  849.     end;
  850. end;
  851.  
  852.  
  853. procedure Register;
  854. begin
  855.     RegisterComponents('Data Controls', [TPrintGrid]);
  856. end;
  857.  
  858.  
  859. end.
  860.